home *** CD-ROM | disk | FTP | other *** search
/ Netscape Plug-Ins Developer's Kit / Netscape_Plug-Ins_Developers_Kit.iso / CGIPERL / MACPERL / MSRCE418.HQX / Perl Source ƒ / MacPerl / Distribute < prev    next >
Encoding:
Text File  |  1994-12-31  |  3.5 KB  |  150 lines
  1. Set DistFolder `Perl -Sx "{0}" "{1}" "{TempFolder}"Distribute.Dup "{2}"`      &&    ╢
  2.     "{TempFolder}"Distribute.Dup                                                            &&    ╢
  3.     Delete -y "{TempFolder}"Distribute.Dup
  4.     Echo '# Clean up afterwards'
  5.     Echo Delete -y ╢'"{DistFolder}"╢' 
  6. Exit
  7.  
  8. #!perl
  9. #######################################################################
  10. #    Project    :    Distr                -    
  11. #    File        :    Distribute        -    Build a distribution
  12. #    Author    :    Matthias Neeracher
  13. #    Started    :    29Jun93                                Language    :    MPW Perl
  14. #    Modified    :    31Jul93    MN    Some unpleasant bugs
  15. #                    27Dec94    MN    Creator fixing, conditional stuffing
  16. #    Last        :    27Dec94
  17. #######################################################################
  18.  
  19. ($distfile,$dup,$archive) = @ARGV;
  20.  
  21. $stuffit = 1;
  22.  
  23. open(DIST, $distfile) || die "$0: Could not open \"$distfile\"";
  24. open(DUP, ">$dup") || die "$0: Could not open \"$dup\"";
  25.  
  26. print DUP "Echo #\n";
  27.  
  28. while (<DIST>) {
  29.     next if /^\s*$/;
  30.     next if /^\s*#/;
  31.     
  32.     undef $atx,$aty;
  33.     
  34.     if (/(.*)AT\s+(\d+)\s*,\s*(\d+)(.*)/) {
  35.         ($atx,$aty,$_) = ($2, $3, $1 . $4);
  36.     }
  37.     
  38.     if (/^\s*STUFFIT\s+(\S+)\s*$/) {
  39.         if ($1 eq "OFF") {
  40.             $stuffit = 0;
  41.         } elsif ($1 eq "ON") {
  42.             $stuffit = 1;
  43.         }
  44.     } elsif (    /^\s*CREATOR\s+(\S+)\s+(\S+)\s*$/ 
  45.                 ||╩/^\s*CREATOR\s+\"([^"]+)\"\s+(\S+)\s*$/
  46.                 ||╩/^\s*CREATOR\s+(\S+)\s+\"([^"]+)\"\s*$/
  47.                 ||╩/^\s*CREATOR\s+\"([^"]+)\"\s+\"([^"]+)\"\s*$/
  48.     ) {
  49.         $creator{$1} = $2;
  50.     } elsif (/^\s*TARGET\s+\"([^"]+)\"\s*$/ || /^\s*TARGET\s+(\S+)\s*$/) {
  51.         $target = $1;
  52.         $target = ":$target" unless ($target =~ /^:/);
  53.         $target = "$target:" unless ($target =~ /:$/);
  54.         $target =~ /^:?([^:]+)/;
  55.         $distfolder = $1;
  56.             
  57.         &mkdirs($target);
  58.         
  59.         # print DUP "SetFile \'$target\' -l $atx,$aty\n" if (defined $atx);
  60.     } elsif (    /^\s*\"([^"]+)\"\s+AS\s+\"([^"]+)\"\s*$/
  61.                 || /^\s*\"([^"]+)\"\s+AS\s+(\S+)\s*$/    
  62.                 ||╩/^\s*(\S+)\s+AS\s+(\S+)\s*$/ 
  63.     ) {
  64.         &linkfile($1, "$target$2", 0);
  65.     } elsif (/^\s*\"([^"]+)\"\s*$/ ||╩/^\s*(\S+)\s*$/) {
  66.         &linkfiles($1, $target);
  67.     } else {
  68.         print STDERR "File \"$distfile\"; Line $. # Syntax Error\n";
  69.     }
  70. }
  71.  
  72. if ($stuffit) {
  73.     print DUP "Stuff -r \'$distfolder\' -o \'$archive\'\n";
  74.     print DUP "Delete -y \'$distfolder\'\n"
  75. }
  76.  
  77. print "\"$distfolder\"\n";
  78.  
  79. sub mkdirs 
  80. {
  81.     local($dir) = @_;
  82.     
  83.     if (!-d $dir) {
  84.         if ($dir =~ /(.*:)[^:]+:/) {
  85.             &mkdirs($1);
  86.         }
  87.         
  88.         mkdir($dir, 0777) || die "Couldn't create directory \"$dir\"";
  89.     }
  90. }
  91.  
  92. sub linkfile
  93. {
  94.     local($from,$to,$linkem) = @_;
  95.  
  96.     ($origcreator, $origtype) = &MacPerl'GetFileInfo($from);
  97.     
  98.     $creator = $creator{$origtype};
  99.     
  100.     if (defined($creator) && $creator eq $origcreator) {
  101.         undef $creator;
  102.     }
  103.     
  104.     print STDERR "\t\t\t$from -> $to\n";
  105.     
  106.     if ($to =~ /(.*):Icon╢n$/) {
  107.         print DUP "SetFile -a C \'$1\'\n";
  108.     }
  109.     
  110.     unlink $to if (-e $to);
  111.     
  112.     if ($linkem && $stuffit && !defined($creator)) {
  113.         $from =~ s/╢n/\n/g;
  114.         $to =~ s/╢n/\n/g;
  115.         symlink($from, $to) || die "Couldn't link \"$from\" to \"$to\"";
  116.     } else {
  117.         $from =~ s/╢n/\'╢n\'/g;
  118.         $to =~ s/╢n/\'╢n\'/g;
  119.         print DUP "Duplicate -y \'$from\' \'$to\'\n";
  120.         print DUP "SetFile -c \'$creator\' \'$to\'\n" if defined($creator);
  121.     }
  122. }
  123.  
  124. sub linkfiles
  125. {
  126.     local($from,$target) = @_;
  127.     
  128.     if ($from =~ /^(.*):([^:]+)$/) {
  129.         ($fromdir,$fromfile) = ($1,$2);
  130.     } else {
  131.         ($fromdir,$fromfile) = (":",$from);
  132.     }
  133.     
  134.     if ($fromfile =~ /[┼?]/) {
  135.         $fromfile =~ s/\./\\./;
  136.         $fromfile =~ s/┼/.*/;
  137.         $fromfile =~ s/\?/./;
  138.         
  139.         opendir(FROMDIR, $fromdir) || "Could not open \"$fromdir\"";
  140.         
  141.         while ($from = readdir(FROMDIR)) {
  142.             next unless $from =~ /^$fromfile$/;
  143.             
  144.             &linkfile("$fromdir:$from", "$target$from", 1);
  145.         }
  146.     } else {
  147.         &linkfile($from,"$target$fromfile", 1);
  148.     }
  149. }
  150.